home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 03 / 8 / DISK0386.ZIP / BANNER.FOR < prev    next >
Text File  |  1985-05-02  |  5KB  |  153 lines
  1. $STORAGE: 4
  2. $DO66
  3. C     BANNER2
  4. C
  5. C     TYPEFACE: FORTUNE LIGHT BY BAUER TYPE FOUNDRY;
  6. C     NOMINAL SIZE, 8 INCHES HIGH
  7. C
  8. C     MOST 029 (EBCDIC) KEYPUNCH SYMBOLS, PLUS LOWER-CASE MULTI-
  9. C     PUNCHING, CAN BE INTERPRETED BY THIS PROGRAM.
  10. C
  11. C        THE SYMBOL "^" IS USED FOR DEGREES (SUPERSCRIPT ZERO).
  12. C        THE UNDERSCORE SYMBOL "_" IS USED FOR "TH" WITH UNDERSCORE.
  13. C
  14. C
  15. C
  16. C     DATA REQUIREMENTS: ONE CARD, FORMAT A1,78A1, FOR EACH PHRASE:
  17. C        A1: "+" OR BLANK PRODUCES BLACK TEXT WITH
  18. C                        WHITE BACKGROUND;
  19. C            "-" PRODUCES WHITE TEXT WITH BLACK
  20. C                        BACKGROUND.
  21. C        78A1: TEXT TO BE PRINTED.
  22. C
  23. C     END OF FILE PROVIDES NORMAL TERMINATION OF THE PROGRAM.
  24. C
  25. C     DEBUGGED AND MOVED TO MS-FORTRAN BY G. EVERHART 1985
  26. C
  27. C
  28.       DIMENSION KARD(78),MAXCRD(78),MINCRD(78),LMAX(89),LMIN(89),
  29.      *   LSTACK(78)
  30.       COMMON MOVE
  31.       COMMON /NUMBRS/ I2,I3,I4,I5,I6,I7
  32.       COMMON /SYMBOL/ NBLANK,NSYM,NSYMX,LFRONT,LFRNTX,LBACK,LBACKX
  33.       COMMON /INIT/ NSYMB(2,89),NCHAR(3000),LMAX,LMIN
  34.     CHARACTER*1 IFNM(50),OFNM(60)
  35. 500   FORMAT(1A1,78A1)
  36. 600   FORMAT(1H1)
  37. 675   FORMAT (14H ENTER LINE:       )
  38. C
  39. C
  40. 680   FORMAT (20H INPUT ERROR--FIRST ,
  41.      *   40HCHARACTER MUST BE A "+", "-", OR A BLANK)
  42.     CHARACTER*4 CNPLUS,CMINUS,CNPBLN
  43.     INTEGER*4 NPLUS,MINUS,NPBLNK
  44.     EQUIVALENCE(NPLUS,CNPLUS),(MINUS,CMINUS),(CNPBLN,NPBLNK)
  45.     CHARACTER*1 CPL,CMI,CSP
  46.     EQUIVALENCE(CPL,CNPLUS)
  47.     EQUIVALENCE(CMI,CMINUS)
  48.     EQUIVALENCE(CSP,CNPBLN)
  49.     CHARACTER*1 CTMP
  50. C USE IN MASKING...
  51. C    DATA CPL,CMI,CSP/'+','-',' '/
  52.     DATA NPLUS,MINUS,NPBLNK/43,45,32/
  53. C      DATA CNPLUS, CMINUS, CNPBLN /1H+, 1H-, 1H  /
  54. CC    DIMENSION LMAX(89),LMIN(89)
  55. C      DATA LMAX,LMIN/80,57,80,73,80,57,80,57,80,74,80,57,80,57,3*80,57,
  56. C     *    5*80,55,3*80,57,3*80,57,80,74,3*80,57,80,57,80,57,80,55,80,55,
  57. C     *    80,55,80,55,80,55,10*80,70,48,80,55,3*80,64,7*80,88,2*80,2*15,
  58. C     *  2*47,2*80,76,80,1,10*1,-1,12*1,-1,7*1,-24,1,-24,5*1,-24,-11,-24,
  59. C     *    7*1,-24,12*1,11,33,1,26,1,1,61,19,7*1,-7,1,1,-9,1,1,11,41,41,
  60. C     *    4,1,1/
  61. C GET INPUT AND OUTPUT FILES
  62. C    CALL RASSIG(5,'CON:')
  63.     OPEN(6,FILE='CON:')
  64.     OPEN(5,FILE='CON:')
  65. C    CALL WASSIG(6,'CON:')
  66. 8008    continue
  67.     WRITE(6,8000)
  68. 8000    FORMAT(' Enter INPUT file specifier')
  69.     read (5,8001)ifnm
  70. 8001    format(80a1)
  71.     write(6,8002)
  72. 8002    format(' Enter OUTPUT file specifier')
  73.     read(5,8001)ofnm
  74. c got the names in now. null terminate them.
  75.     do 8003 n=1,80
  76.     nn=81-n
  77.     if(ICHAR(ifnm(nn)).gt.32)goto 8004
  78.     ifnm(nn)=0
  79. 8003    continue
  80. 8004    continue
  81.     do 8005 n=1,80
  82.     nn=81-n
  83.     if(ICHAR(ofnm(nn)).gt.32)goto 8006
  84.     ofnm(nn)=0
  85. 8005    continue
  86. 8006    continue
  87. c above null terminates filenames
  88. c now assign them to units we use in rest
  89.     if(ICHAR(ifnm(1)).gt.32)call Rassig(1,ifnm)
  90.     if(ICHAR(ifnm(1)).le.32)call Rassig(1,'CON:')
  91.     if(ICHAR(ofnm(1)).gt.32)call Wassig(2,ofnm)
  92.     if(ICHAR(ofnm(1)).le.32)call Wassig(2,'lettrs.dat')
  93. c always prompt on 6 which is console.
  94. 10    WRITE (6,675)
  95.       READ(1,500,END = 90) NEGPOS,KARD
  96. C MASK ALL THE CODES READ TO ENSURE SANITY
  97. C KARD IS 78 WIDE
  98.     CTMP=CHAR(NEGPOS)
  99.     NEGPOS=ICHAR(CTMP)
  100.     DO 731 N=1,78
  101. C USE STORAGE INTO C*1 VARIABLE AS A WAY TO THROW OUT ALL
  102. C POSSIBLE HIGH ORDER BITS THAT MAY BE SET.
  103.     CTMP=CHAR(KARD(N))
  104.     KARD(N)=ICHAR(CTMP)
  105. 731    CONTINUE
  106.       IF ((NEGPOS .EQ. NPBLNK) .OR. (NEGPOS .EQ. NPLUS)) GO TO 15
  107.       IF (NEGPOS .EQ. MINUS) GO TO 17
  108.       WRITE (6,680)
  109.       GO TO 10
  110. 15    LFRONT = NSYM
  111.       LFRNTX = NSYMX
  112.       LBACK = NBLANK
  113.       LBACKX = NBLANK
  114.       NP = POS
  115.       GO TO 20
  116. 17    NP = NEG
  117.       LFRONT = NBLANK
  118.       LFRNTX = NBLANK
  119.       LBACK = NSYM
  120.       LBACKX = NSYMX
  121. 20    CONTINUE
  122.       DO 30 ICOL=1,78
  123.       JCOL = 79 - ICOL
  124.       IF(KARD(JCOL).NE.NBLANK) GO TO 40
  125. 30    CONTINUE
  126. 40    NTOTAL = 0
  127.       DO 60 ICOL=1,JCOL
  128.       DO 50 ISYMB=1,89
  129.       IF(KARD(ICOL).NE.NSYMB(1,ISYMB)) GO TO 50
  130.       NTOTAL = NTOTAL + NSYMB(2,ISYMB)/I4 + 4
  131.       MAXCRD(ICOL) = LMAX(ISYMB)
  132.       MINCRD(ICOL) = LMIN(ISYMB)
  133.       LSTACK(ICOL) = ISYMB
  134.       GO TO 60
  135. 50    CONTINUE
  136. 60    CONTINUE
  137.       CALL MINMAX(MAXCRD,JCOL,MAXL,JUNK,IMAX,IMIN)
  138.       CALL MINMAX(MINCRD,JCOL,JUNK,MINL,IMAX,IMIN)
  139.       NCOLS = MAXL - MINL + 1
  140.       MOVE = (132-NCOLS)/2 - MINL
  141.       NSPARE = (INT(FLOAT(NTOTAL)/66.+1.5)*66-NTOTAL-6)/2
  142.       WRITE(2,600)
  143.       CALL BAXX(NSPARE,2)
  144.       DO 80 ICOL=1,JCOL
  145. 70    CALL PRNT ( LSTACK(ICOL) )
  146. 80    CONTINUE
  147.       CALL BAXX(NSPARE,2)
  148.       WRITE(2,600)
  149.       GO TO 10
  150. 90    CONTINUE
  151.       END
  152.  
  153.